home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok56 / turbofiles_v2.0 / turbofiles.mod < prev    next >
Text File  |  1993-11-04  |  10KB  |  384 lines
  1.  
  2. (**********************************************************************
  3.  
  4.     :Program.    (Turbo)Files
  5.     :Contents.   Module for filehandling, like FileSystem
  6.     :Author.     Stefan Salewski
  7.     :Address.    Stefan Salewski, Stolper Weg 3, D-2160 Stade
  8.     :Copyright.  FD
  9.     :Language.   Oberon/68000-Assembler
  10.     :Translator. Amiga-Oberon-Compiler V2.0 and A68k
  11.     :History.    V2.0     12-06-91
  12.     :Remark.     The modules Files and TurboFiles does the same, but
  13.     :Remark.     TurboFiles is quicker, because the important
  14.     :Remark.     Procedures are coded in Assembler.
  15.     :Remark.     Link from CLI: OLink MyProgram OBJ TurboFiles.o
  16.     :Remark.     or use JOIN to merge TurboFiles.obj(s) and TurboFiles.o
  17.  
  18. **********************************************************************)
  19.  
  20. MODULE TurboFiles;
  21.   IMPORT SYSTEM,
  22.          OberonLib,
  23.          Dos,
  24.          SecureDos,
  25.          Exec,
  26.          Random,
  27.          ASCII,
  28.          Strings;
  29.  
  30.   CONST
  31.     D0= 0; D1= 1;
  32.     A0= 8; A1= 9;
  33.  
  34.   CONST
  35.     newFile* = TRUE;    (* open new file (delete old one) for read/write *)
  36.     oldFile* = FALSE;   (* open existing file for read/write *)
  37.  
  38.   CONST (* Error-Codes = file.res *)
  39.     done*         = 0;
  40.     notdone*      = 1;
  41.     notOpen*      = 2;
  42.     openError*    = 3;
  43.     readError*    = 4;
  44.     writeError*   = 5;
  45.     seekError*    = 6;
  46.     endOfFile*    = 7;
  47.     outOfMem*     = 8;
  48.     notExists*    = 9;
  49.  
  50.   CONST (* Modes for SetPos *)
  51.     beginning* = Dos.beginning;
  52.     current*   = Dos.current;
  53.     end*       = Dos.end;
  54.  
  55.   TYPE
  56.     File* = RECORD
  57.               fhPtr:Dos.FileHandlePtr;
  58.               dosBase:Exec.ADDRESS;
  59.               base:Exec.ADDRESS;
  60.               top:Exec.ADDRESS;
  61.               filePos:LONGINT;
  62.               startLength:LONGINT;
  63.               act:Exec.ADDRESS;
  64.               readTop:Exec.ADDRESS;
  65.               writeBase:Exec.ADDRESS;
  66.               writeTop:Exec.ADDRESS;
  67.               open:BOOLEAN;
  68.               res*:SHORTINT;
  69.            END;
  70.  
  71.   VAR
  72.     DosBase:Exec.ADDRESS;
  73.     ExecBase[4]:Exec.ADDRESS;
  74.  
  75.   PROCEDURE CopyMem{ExecBase,-624}(source{8}:Exec.ADDRESS;
  76.                                    dest{9}:Exec.ADDRESS;
  77.                                    size{0}:LONGINT);
  78.  
  79.   PROCEDURE DosRead{DosBase,-42}(file{1}:Dos.FileHandlePtr;
  80.                                  buffer{2}:Exec.ADDRESS;
  81.                                  length{3}:LONGINT):LONGINT;
  82.  
  83.   PROCEDURE DosWrite{DosBase,-48}(file{1}:Dos.FileHandlePtr;
  84.                                   buffer{2}:Exec.ADDRESS;
  85.                                   length{3}:LONGINT):LONGINT;
  86.  
  87.   PROCEDURE DeleteFile*{DosBase,-72}(name{1}:ARRAY OF CHAR):BOOLEAN;
  88.  
  89.   PROCEDURE ReadChar*{"TurboReadChar"}
  90.                      (VAR f{A0}:File;VAR c{A1}:BYTE):BOOLEAN;
  91.  
  92.   PROCEDURE ReadBytes*{"TurboReadBytes"}
  93.                       (VAR f{A0}:File;adr{A1}:Exec.ADDRESS;
  94.                        len{D1}:LONGINT):LONGINT;
  95.  
  96.   PROCEDURE Read*{"TurboRead"}
  97.                  (VAR f:File;VAR to:ARRAY OF BYTE):BOOLEAN;
  98.  
  99.   PROCEDURE WriteChar*{"TurboWriteChar"}
  100.                       (VAR f{A0}:File;c{D1}:BYTE):BOOLEAN;
  101.  
  102.   PROCEDURE WriteBytes*{"TurboWriteBytes"}
  103.                        (VAR f{A0}:File;adr{A1}:Exec.ADDRESS;
  104.                         len{D1}:LONGINT):BOOLEAN;
  105.  
  106.   PROCEDURE Write*{"TurboWrite"}
  107.                   (VAR f:File;from:ARRAY OF BYTE):BOOLEAN;
  108.  
  109.   PROCEDURE Size*{"TurboSize"}
  110.                  (VAR f{A0}:File):LONGINT;
  111.  
  112.   PROCEDURE GetPos*{"TurboGetPos"}
  113.                    (VAR f{A0}:File):LONGINT;
  114.  
  115.   PROCEDURE SetPos*{"TurboSetPos"}
  116.                    (VAR f{A0}:File;offset{D0}:LONGINT;
  117.                     mode{D1}:LONGINT):BOOLEAN;
  118.  
  119.   PROCEDURE MinLongInt(i,j:LONGINT):LONGINT;
  120.   BEGIN
  121.     IF i<j THEN RETURN i ELSE RETURN j END;
  122.   END MinLongInt;
  123.  
  124.   PROCEDURE Exists*(name: ARRAY OF CHAR;VAR size:LONGINT):BOOLEAN;
  125.   (* $CopyArrays- *)
  126.     VAR
  127.       flPtr:Dos.FileLockPtr;
  128.       (* info:Dos.FileInfoBlock; must be on a 4 byte boundary !!! *)
  129.       infoPtr:Dos.FileInfoBlockPtr;
  130.       exists:BOOLEAN;
  131.   BEGIN
  132.     exists:=FALSE;
  133.     size:=0;
  134.     flPtr:=SecureDos.Lock(name,Dos.sharedLock);
  135.     IF flPtr#NIL THEN
  136.       NEW(infoPtr);
  137.       IF infoPtr#NIL THEN
  138.         IF Dos.Examine(flPtr,infoPtr^) THEN
  139.           exists:=TRUE;
  140.           IF infoPtr.dirEntryType<0 THEN (* is a file *)
  141.             size:=infoPtr.size;
  142.           ELSE
  143.             size:=-1                  (* is a directory *)
  144.           END;
  145.         END;
  146.         DISPOSE(infoPtr);
  147.       END;
  148.       SecureDos.UnLock(flPtr);
  149.     END;
  150.     RETURN exists
  151.   END Exists;
  152.  
  153.   PROCEDURE Open*(VAR f:File;name:ARRAY OF CHAR;
  154.                   bufferSize:LONGINT;new:BOOLEAN):BOOLEAN;
  155.   (* $CopyArrays- *)
  156.     VAR
  157.       buf:Exec.ADDRESS;
  158.       mode:LONGINT;
  159.   BEGIN
  160.     f.open:=FALSE;
  161.     IF new THEN
  162.       f.startLength:=0;
  163.       mode:=Dos.newFile
  164.     ELSE
  165.       mode:=Dos.oldFile;
  166.       IF NOT Exists(name,f.startLength) OR (f.startLength<0) THEN
  167.         f.res:=notExists;
  168.         RETURN FALSE
  169.       END;
  170.     END;
  171.     IF bufferSize<1 THEN bufferSize:=1 END;
  172.     OberonLib.New(buf,bufferSize);
  173.     IF buf=NIL THEN
  174.       f.res:=outOfMem;
  175.       RETURN FALSE
  176.     END;
  177.     f.fhPtr:=SecureDos.Open(name,mode);
  178.     IF f.fhPtr=NIL THEN
  179.       OberonLib.Dispose(buf);
  180.       f.res:=openError;
  181.       RETURN FALSE
  182.     ELSE
  183.       f.dosBase:=DosBase;
  184.       f.filePos:=0;
  185.       f.base:=buf;
  186.       f.top:=buf+bufferSize;
  187.       f.act:=buf;
  188.       f.readTop:=buf;
  189.       f.writeTop:=buf;
  190.       f.writeBase:=f.top;
  191.       f.open:=TRUE;
  192.       f.res:=done;
  193.       RETURN TRUE;
  194.     END;
  195.   END Open;
  196.  
  197.   PROCEDURE Close*(VAR f:File):BOOLEAN;
  198.   BEGIN
  199.     IF (NOT f.open) OR (f.res=notOpen) THEN RETURN FALSE END;
  200.     IF f.writeTop>f.writeBase THEN
  201.       IF Dos.Seek(f.fhPtr,f.writeBase-f.readTop,Dos.current) > 0 THEN END;
  202.       IF DosWrite(f.fhPtr,f.writeBase,f.writeTop-f.writeBase)> 0 THEN END;
  203.     END;
  204.     SecureDos.Close(f.fhPtr);
  205.     OberonLib.Dispose(f.base);
  206.     f.open:=FALSE;
  207.     f.res:=notOpen;
  208.     RETURN TRUE;
  209.   END Close;
  210.  
  211.   PROCEDURE ReadString*(VAR f:File;VAR str:ARRAY OF CHAR):INTEGER;
  212.     VAR i:INTEGER;
  213.   BEGIN
  214.     i:=-1;
  215.     LOOP
  216.       INC(i);
  217.       IF i=LEN(str) THEN EXIT END;
  218.       IF NOT ReadChar(f,str[i]) THEN EXIT END;
  219.       IF (str[i]=ASCII.nul) OR (str[i]=ASCII.eol) THEN EXIT END;
  220.     END;
  221.     IF i<LEN(str) THEN str[i]:=0X END;
  222.     RETURN i
  223.   END ReadString;
  224.  
  225.   PROCEDURE WriteString*(VAR f:File;str:ARRAY OF CHAR):BOOLEAN;
  226.   (* CopyArrays- *)
  227.     VAR i:INTEGER;
  228.   BEGIN
  229.     i:=0;
  230.     WHILE (i<LEN(str)) AND (str[i]#0X) DO
  231.       IF WriteChar(f,str[i]) THEN END;
  232.       INC(i);
  233.     END;
  234.     RETURN f.res=done;
  235.   END WriteString;
  236.  
  237.   PROCEDURE WriteLn*(VAR f:File):BOOLEAN;
  238.   BEGIN
  239.     RETURN WriteChar(f,ASCII.lf);
  240.   END WriteLn;
  241.  
  242.   PROCEDURE Search*(VAR f:File;str:ARRAY OF BYTE;len:INTEGER):LONGINT;
  243.   (* $CopyArrays- *)
  244.   VAR
  245.     i:INTEGER;
  246.     b:BYTE;
  247.   BEGIN
  248.     IF NOT (f.open) OR (f.res#done) THEN RETURN -1 END;
  249.     IF (len>LEN(str)) OR (len<=0) THEN
  250.       len:=LEN(str)
  251.     END;
  252.     DEC(len);
  253.     LOOP
  254.       i:=0;
  255.       LOOP
  256.         IF NOT ReadChar(f,b) THEN RETURN -1 END;
  257.         IF (b#str[i]) OR (i=len) THEN
  258.           EXIT
  259.         END;
  260.         INC(i);
  261.       END;
  262.       IF (str[i]=b) AND SetPos(f,-i-1,current) THEN
  263.         RETURN GetPos(f)
  264.       ELSIF (i>0) THEN
  265.        IF SetPos(f,-i,current) THEN END;
  266.       END;
  267.     END;
  268.   END Search;
  269.  
  270.   PROCEDURE Code*(fileName,codeWord:ARRAY OF CHAR;decode:BOOLEAN):BOOLEAN;
  271.   (* $CopyArrays- *)
  272.     CONST
  273.       Mult=2;
  274.       CodeStringSize=127;
  275.       BufferSize=1024;
  276.     TYPE
  277.       CodeString=ARRAY CodeStringSize OF SHORTINT;
  278.  
  279.     VAR
  280.       act,i:LONGINT;
  281.       cWLen:LONGINT;
  282.       f:File;
  283.       eof:BOOLEAN;
  284.       code,readPuffer,writePuffer,index:CodeString;
  285.  
  286.     PROCEDURE Permute(VAR index,code:CodeString;len:SHORTINT);
  287.     VAR
  288.       qsum:LONGINT;
  289.       i,h,rnd:SHORTINT;
  290.     BEGIN
  291.       (* generating a permutation of the numbers 0..(len-1).
  292.          This permutation depends on code and will be
  293.          stored in index
  294.       *)
  295.       qsum:=0;
  296.       i:=0;
  297.       WHILE i<len DO
  298.         INC(qsum,code[i]);
  299.         index[i]:=i;
  300.         INC(i);
  301.       END;
  302.       Random.PutSeed(qsum);
  303.       i:=0;
  304.       WHILE i<len DO
  305.         rnd:=SHORT(Random.RND(len));
  306.         h:=index[i];
  307.         index[i]:=index[rnd];
  308.         index[rnd]:=h;
  309.         INC(i);
  310.       END;
  311.     END Permute;
  312.  
  313.   BEGIN
  314.     cWLen:=MinLongInt(Strings.Length(codeWord),CodeStringSize);
  315.     CopyMem(SYSTEM.ADR(codeWord),SYSTEM.ADR(code),cWLen);
  316.     IF cWLen<=0 THEN
  317.       RETURN FALSE
  318.     END;
  319.     IF Open(f,fileName,BufferSize,oldFile) THEN
  320.       WHILE cWLen < (CodeStringSize DIV 2) DO
  321.         CopyMem(SYSTEM.ADR(code),SYSTEM.ADR(code)+cWLen,cWLen);
  322.         INC(cWLen,cWLen);
  323.       END;
  324.       Permute(index,code,SHORT(SHORT(cWLen)));
  325.       i:=0;
  326.       WHILE i<cWLen DO
  327.         (* $OvflChk- *)
  328.         code[i]:=code[i]*Mult;
  329.         (* $OvflChk= *)
  330.         INC(i);
  331.       END;
  332.       eof:=FALSE;
  333.       WHILE NOT eof DO
  334.         act:=ReadBytes(f,SYSTEM.ADR(readPuffer),cWLen);
  335.         IF act<cWLen THEN
  336.           eof:=TRUE;
  337.           f.res:=done; (* So I can write to the file again *)
  338.           Permute(index,code,SHORT(SHORT(act)))
  339.         END;
  340.         IF NOT decode THEN
  341.           i:=0;
  342.           WHILE i<act DO
  343.             (* $OvflChk- *)
  344.             INC(readPuffer[i],code[i]);
  345.             (* $OvflChk= *)
  346.             INC(i);
  347.           END;
  348.           i:=0;
  349.           WHILE i<act DO
  350.             writePuffer[i]:=readPuffer[index[i]];
  351.             INC(i);
  352.           END;
  353.         ELSE
  354.           i:=0;
  355.           WHILE i<act DO
  356.             writePuffer[index[i]]:=readPuffer[i];
  357.             INC(i);
  358.           END;
  359.           i:=0;
  360.           WHILE i<act DO
  361.             (* $OvflChk- *)
  362.             DEC(writePuffer[i],code[i]);
  363.             (* $OvflChk= *)
  364.             INC(i);
  365.           END;
  366.         END;
  367.         IF SetPos(f,-act,current) THEN END;
  368.         IF WriteBytes(f,SYSTEM.ADR(writePuffer),act) THEN END;
  369.       END;
  370.       IF Close(f) THEN END;
  371.       RETURN TRUE
  372.     ELSE
  373.       RETURN FALSE
  374.     END;
  375.   END Code;
  376.  
  377. BEGIN
  378.   DosBase:=Dos.dos;
  379.   IF DosBase=NIL THEN HALT(0) END;
  380.  
  381. END TurboFiles.
  382.  
  383.  
  384.